Night Owl 6/Night Owl's Shareware - PDSI-006 - Night Owl Corp (1990).iso/038a/pbpopsi.zip/POPSI.BAS

BASIC Source File | 1991-09-03 | 14KB | 178 lines

     CLS : COLOR 15: LOCATE 5, 31: PRINT "***  P O P S I  ***": COLOR 7
     LOCATE 8, 15: PRINT "Compiled using the ULTIMATE programming language..."
     LOCATE 10, 16: PRINT "PowerBASIC 2.10a   F(1) ends the drawing process."
     COLOR 14
     LOCATE 12, 17: PRINT "Floating Point Unit Helpful, But Not Required."
     COLOR 31: LOCATE 23, 30: PRINT "Hit a key to begin..."
149  aa$=inkey$:if aa$="" goto 149
     COLOR 7

     GOTO 1520  'configure system
150  GOSUB 1760 'assign scalar data

     VIEW (W1, W7)-(W2, W8): GOSUB 290
     VIEW (W3, W7)-(W4, W8): R2 = 4.89778: GOSUB 1800: GOSUB 290
     VIEW (W5, W7)-(W6, W8): R2 = 4.71239: R3 = .08539: GOSUB 1800: GOSUB 290
     VIEW (W1, W9)-(W2, W10): R2 = 5.29448: R3 = 6.08319: GOSUB 1800: GOSUB 290
     VIEW (W3, W9)-(W4, W10): R2 = 4.71239: R3 = 5.78319: GOSUB 1800: GOSUB 290
     VIEW (W5, W9)-(W6, W10): R2 = 4.41239: R3 = 6.08319: GOSUB 1800: GOSUB 290
250  aa$=inkey$
      if aa$="" goto 250
 GOTO 1470

    'STEP ONE: create body of cylinder
290  X = 30: R4 = 0: R5 = 0: GOSUB 1380: Z = 45: GOSUB 1430: PSET (SX, SY), C3: XNT = SX: YNT = SY'set start point for end of cylinder
     FOR T = 1 TO 72 STEP 1: X = 30: R5 = R5 + .08727: GOSUB 1380: Z = 45: GOSUB 1430: LINE -(SX, SY), C3: NEXT T'draw top circumference for end of cylinder
     X = 30: R4 = 0: R5 = .17454: GOSUB 1380: Z = -45: GOSUB 1430: PSET (SX, SY), C3: XFT = SX: YFT = SY'set start point for bottom of cylinder
     FOR T = 1 TO 32 STEP 1: X = 30: R5 = R5 + .08727: GOSUB 1380: Z = -45: GOSUB 1430: LINE -(SX, SY), C3: NEXT T: XFB = SX: YFB = SY'draw visible portion of circumference of bottom of cylinder
     LINE (XNT, YNT)-(XFT, YFT), C3: X = 0: Z = 45: Y = 30: GOSUB 1430: PSET (SX, SY), C3: LINE -(XFB, YFB), C3'connect top and bottom of cylinder
     X = 0: Z = 45: Y = 0: GOSUB 1430: PAINT (SX, SY), C0, C3: X = 30: Y = 0: Z = 0: GOSUB 1430: PAINT (SX, SY), C3, C3'paint top of cylinder black, paint curved surface white

    'STEP TWO: create pedestal graphic on cylinder
     X = 30: R5 = 2.601631: GOSUB 1380: Z = -40: GOSUB 1430: PSET (SX, SY), C1: X = 30: R5 = 2.601631: GOSUB 1380: Z = 2.5: GOSUB 1430: LINE -(SX, SY), C1
     X = 30: R5 = .490874: GOSUB 1380: Z = -40: GOSUB 1430: PSET (SX, SY), C1: X = 30: R5 = .490874: GOSUB 1380: Z = 2.5: GOSUB 1430: LINE -(SX, SY), C1
     X = 30: R5 = .490874: GOSUB 1380: Z = -40: GOSUB 1430: PSET (SX, SY), C3
     FOR R5 = .490874 TO 2.601631 STEP .0490873: X = 30: GOSUB 1380: Z = -40: GOSUB 1430: LINE -(SX, SY), C1: NEXT R5
     RESTORE 1850: R5 = .490874: X = 30: GOSUB 1380: READ Z: GOSUB 1430: PSET (SX, SY), C1
     FOR R5 = .490874 TO 2.601631 STEP .0490873: X = 30: GOSUB 1380: READ Z: GOSUB 1430: LINE -(SX, SY), C1: NEXT R5'arc on pedestal graphics
     X = 30: R5 = 1.570796: GOSUB 1380: Z = -25: GOSUB 1430: PAINT (SX, SY), C1, C1

    'STEP THREE: create upper semi-circle graphic
     RESTORE 1860: R5 = .638136: X = 30: GOSUB 1380: READ Z: GOSUB 1430: PSET (SX, SY), C1
     FOR R5 = .638136 TO 2.552544 STEP .0490873: X = 30: GOSUB 1380: READ Z: GOSUB 1430: LINE -(SX, SY), C1: NEXT R5
     RESTORE 1870: R5 = .638136: X = 30: GOSUB 1380: READ Z: GOSUB 1430: PSET (SX, SY), C1
     FOR R5 = .638136 TO 2.552544 STEP .0490873: X = 30: GOSUB 1380: READ Z: GOSUB 1430: LINE -(SX, SY), C1: NEXT R5
     X = 30: R5 = 1.570796: GOSUB 1380: Z = 32: GOSUB 1430: PAINT (SX, SY), C1, C1

    'STEP FOUR: create lower semi-circle graphic
     RESTORE 1880: R5 = .638136: X = 30: GOSUB 1380: READ Z: GOSUB 1430: PSET (SX, SY), C2
     FOR R5 = .638136 TO 2.552544 STEP .0490873: X = 30: GOSUB 1380: READ Z: GOSUB 1430: LINE -(SX, SY), C2: NEXT R5
     RESTORE 1890: R5 = .638136: X = 30: GOSUB 1380: READ Z: GOSUB 1430: PSET (SX, SY), C2
     FOR R5 = .638136 TO 2.552544 STEP .0490873: X = 30: GOSUB 1380: READ Z: GOSUB 1430: LINE -(SX, SY), C2: NEXT R5
     X = 30: R5 = 1.570796: GOSUB 1380: Z = 0: GOSUB 1430: PAINT (SX, SY), C2, C2

    'STEP FIVE: create alphanumerics POPSI
    'draw the first P
     C = C0'assign color for alphanumeric drawing code
     RESTORE 1900: R5 = .539961: X = 30: GOSUB 1380: READ Z: GOSUB 1430: PSET (SX, SY), C
     X = 30: GOSUB 1380: READ Z: GOSUB 1430: LINE -(SX, SY), C
     F = .0490873: FOR T = 1 TO 6 STEP 1: R5 = R5 + F: X = 30: GOSUB 1380: READ Z: GOSUB 1430: LINE -(SX, SY), C: NEXT T
     FOR T = 1 TO 2 STEP 1: R5 = R5 + F: X = 30: GOSUB 1380: READ Z: GOSUB 1430: LINE -(SX, SY), C: NEXT T
     FOR T = 1 TO 2 STEP 1: R5 = R5 + .5 * F: X = 30: GOSUB 1380: READ Z: GOSUB 1430: LINE -(SX, SY), C: NEXT T
     FOR T = 1 TO 2 STEP 1: R5 = R5 - .5 * F: X = 30: GOSUB 1380: READ Z: GOSUB 1430: LINE -(SX, SY), C: NEXT T
     R5 = R5 - F: X = 30: GOSUB 1380: READ Z: GOSUB 1430: LINE -(SX, SY), C
     FOR T = 1 TO 4 STEP 1: R5 = R5 - F: X = 30: GOSUB 1380: READ Z: GOSUB 1430: LINE -(SX, SY), C: NEXT T
     X = 30: GOSUB 1380: READ Z: GOSUB 1430: LINE -(SX, SY), C
     R5 = .539961: X = 30: GOSUB 1380: READ Z: GOSUB 1430: LINE -(SX, SY), C
     RESTORE 1910: R5 = .687223: X = 30: GOSUB 1380: READ Z: GOSUB 1430: PSET (SX, SY), C: X = 30: GOSUB 1380: READ Z: GOSUB 1430: LINE -(SX, SY), C
     R5 = .805398: X = 30: GOSUB 1380: READ Z: GOSUB 1430: LINE -(SX, SY), C: X = 30: GOSUB 1380: READ Z: GOSUB 1430: LINE -(SX, SY), C
     R5 = .687223: X = 30: GOSUB 1380: READ Z: GOSUB 1430: LINE -(SX, SY), C

    'draw the second P
     RESTORE 1900: R5 = 1.521709: X = 30: GOSUB 1380: READ Z: GOSUB 1430: PSET (SX, SY), C
     X = 30: GOSUB 1380: READ Z: GOSUB 1430: LINE -(SX, SY), C
     F = .0490873: FOR T = 1 TO 6 STEP 1: R5 = R5 + F: X = 30: GOSUB 1380: READ Z: GOSUB 1430: LINE -(SX, SY), C: NEXT T
     FOR T = 1 TO 2 STEP 1: R5 = R5 + F: X = 30: GOSUB 1380: READ Z: GOSUB 1430: LINE -(SX, SY), C: NEXT T
     FOR T = 1 TO 2 STEP 1: R5 = R5 + .5 * F: X = 30: GOSUB 1380: READ Z: GOSUB 1430: LINE -(SX, SY), C: NEXT T
     FOR T = 1 TO 2 STEP 1: R5 = R5 - .5 * F: X = 30: GOSUB 1380: READ Z: GOSUB 1430: LINE -(SX, SY), C: NEXT T
     R5 = R5 - F: X = 30: GOSUB 1380: READ Z: GOSUB 1430: LINE -(SX, SY), C
     FOR T = 1 TO 4 STEP 1: R5 = R5 - F: X = 30: GOSUB 1380: READ Z: GOSUB 1430: LINE -(SX, SY), C: NEXT T
     X = 30: GOSUB 1380: READ Z: GOSUB 1430: LINE -(SX, SY), C
     R5 = 1.521709: X = 30: GOSUB 1380: READ Z: GOSUB 1430: LINE -(SX, SY), C
     RESTORE 1910: R5 = 1.668971: X = 30: GOSUB 1380: READ Z: GOSUB 1430: PSET (SX, SY), C: X = 30: GOSUB 1380: READ Z: GOSUB 1430: LINE -(SX, SY), C
     R5 = 1.767146: X = 30: GOSUB 1380: READ Z: GOSUB 1430: LINE -(SX, SY), C: X = 30: GOSUB 1380: READ Z: GOSUB 1430: LINE -(SX, SY), C
     R5 = 1.668971: X = 30: GOSUB 1380: READ Z: GOSUB 1430: LINE -(SX, SY), C

    'draw the O
     RESTORE 1920: R5 = .981748: X = 30: GOSUB 1380: READ Z: GOSUB 1430: PSET (SX, SY), C
     FOR T = 1 TO 10 STEP 1: X = 30: R5 = R5 + F: GOSUB 1380: READ Z: GOSUB 1430: LINE -(SX, SY), C: NEXT T
      FOR T = 1 TO 2 STEP 1: X = 30: R5 = R5 + .5 * F: GOSUB 1380: READ Z: GOSUB 1430: LINE -(SX, SY), C: NEXT T
      FOR T = 1 TO 2 STEP 1: X = 30: GOSUB 1380: READ Z: GOSUB 1430: LINE -(SX, SY), C: NEXT T
      FOR T = 1 TO 2 STEP 1: X = 30: R5 = R5 - .5 * F: GOSUB 1380: READ Z: GOSUB 1430: LINE -(SX, SY), C: NEXT T
      FOR T = 1 TO 11 STEP 1: X = 30: R5 = R5 - F: GOSUB 1380: READ Z: GOSUB 1430: LINE -(SX, SY), C: NEXT T
      X = 30: GOSUB 1380: READ Z: GOSUB 1430: LINE -(SX, SY), C
      X = 30: R5 = .981748: GOSUB 1380: READ Z: GOSUB 1430: LINE -(SX, SY), C
      RESTORE 1930: R5 = 1.129009: X = 30: GOSUB 1380: READ Z: GOSUB 1430: PSET (SX, SY), C
      FOR T = 1 TO 9 STEP 1: X = 30: R5 = R5 + .5 * F: GOSUB 1380: READ Z: GOSUB 1430: LINE -(SX, SY), C: NEXT T
      X = 30: GOSUB 1380: READ Z: GOSUB 1430: LINE -(SX, SY), C
      FOR T = 1 TO 9 STEP 1: X = 30: R5 = R5 - .5 * F: GOSUB 1380: READ Z: GOSUB 1430: LINE -(SX, SY), C: NEXT T

     'draw the S
      RESTORE 1940: R5 = 1.963495: X = 30: GOSUB 1380: READ Z: GOSUB 1430: PSET (SX, SY), C
      FOR T = 1 TO 9 STEP 1: X = 30: R5 = R5 + F: GOSUB 1380: READ Z: GOSUB 1430: LINE -(SX, SY), C: NEXT T
      X = 30: GOSUB 1380: READ Z: GOSUB 1430: LINE -(SX, SY), C
      FOR T = 1 TO 6 STEP 1: X = 30: R5 = R5 - F: GOSUB 1380: READ Z: GOSUB 1430: LINE -(SX, SY), C: NEXT T
      FOR T = 1 TO 6 STEP 1: X = 30: R5 = R5 + F: GOSUB 1380: READ Z: GOSUB 1430: LINE -(SX, SY), C: NEXT T
      X = 30: R5 = R5 + .5 * F: GOSUB 1380: READ Z: GOSUB 1430: LINE -(SX, SY), C
      X = 30: R5 = R5 - .5 * F: GOSUB 1380: READ Z: GOSUB 1430: LINE -(SX, SY), C
      FOR T = 1 TO 9 STEP 1: X = 30: R5 = R5 - F: GOSUB 1380: READ Z: GOSUB 1430: LINE -(SX, SY), C: NEXT T
      X = 30: GOSUB 1380: READ Z: GOSUB 1430: LINE -(SX, SY), C
      FOR T = 1 TO 5 STEP 1: X = 30: R5 = R5 + F: GOSUB 1380: READ Z: GOSUB 1430: LINE -(SX, SY), C: NEXT T
      X = 30: R5 = R5 + .5 * F: GOSUB 1380: READ Z: GOSUB 1430: LINE -(SX, SY), C
      X = 30: R5 = R5 - .5 * F: GOSUB 1380: READ Z: GOSUB 1430: LINE -(SX, SY), C
      FOR T = 1 TO 5 STEP 1: X = 30: R5 = R5 - F: GOSUB 1380: READ Z: GOSUB 1430: LINE -(SX, SY), C: NEXT T
      X = 30: R5 = 1.963495: GOSUB 1380: READ Z: GOSUB 1430: LINE -(SX, SY), C

     'draw the I
      RESTORE 1950: R5 = 2.454369: X = 30: GOSUB 1380: READ Z: GOSUB 1430: PSET (SX, SY), C: X = 30: GOSUB 1380: READ Z: GOSUB 1430: LINE -(SX, SY), C
      R5 = 2.601631: X = 30: GOSUB 1380: READ Z: GOSUB 1430: LINE -(SX, SY), C: X = 30: GOSUB 1380: READ Z: GOSUB 1430: LINE -(SX, SY), C
      R5 = 2.454369: X = 30: GOSUB 1380: READ Z: GOSUB 1430: LINE -(SX, SY), C
      RETURN

     'module: calculation of 3D world coordinates
1380  SR4 = SIN(R4): CR4 = COS(R4): SR5 = SIN(R5): CR5 = COS(R5)
      X1 = SR5 * X: Y = (-1) * (CR5 * X): X = CR4 * X1: Z = SR4 * X1: RETURN

     'module:  perspective calculations for Cartesian world coordinates
1430  X = (-1) * X: XA = CR1 * X - SR1 * Z: ZA = SR1 * X + CR1 * Z: X = CR2 * XA + SR2 * Y: YA = CR2 * Y - SR2 * XA: Z = CR3 * ZA - SR3 * YA: Y = SR3 * ZA + CR3 * YA: X = X + MX: Y = Y + MY: Z = Z + MZ: SX = D * X / Z: SY = D * Y / Z: RETURN

     'module: return to BASIC interpreter
1470  CLS : SCREEN 0, 0, 0, 0: WIDTH 80: COLOR 7, 0, 0: LOCATE 1, 1, 1: CLS : END

     'module:  UNIVERSAL
     'This routine configures the program for the hardware/software being used.
1520  KEY OFF: CLS : ON ERROR GOTO 1560'trap if not Enhanced Display + EGA
      SCREEN 9, , 0, 0: COLOR 7, 0: PALETTE 1, 12: PALETTE 2, 9: PALETTE 3, 7: C0 = 0: C1 = 1: C2 = 2: C3 = 3: LOCATE 1, 1: PRINT "ED-EGA 640x350 16-color mode"
      GOSUB 1990  'jump to viewport assignment routine
      GOTO 1690  'jump to screen coordinates set-up
1560  RESUME 1570
1570  ON ERROR GOTO 1610  'trap if not Color Display + EGA
      SCREEN 8, , 0, 0: COLOR 7, 0: PALETTE 1, 4: PALETTE 2, 9: PALETTE 3, 7: C0 = 0: C1 = 1: C2 = 2: C3 = 3: LOCATE 1, 1: PRINT "CD-EGA 640x200 16-color mode"
      GOSUB 2000  'jump to viewport assignment routine
      GOTO 1690  'jump to screen coordinates set-up
1610  RESUME 1670

1670  SCREEN 1, 0: COLOR 0, 1: C0 = 0: C1 = 2: C2 = 1: C3 = 3: LOCATE 1, 1: PRINT "CGA 320x200 4-color mode"
      GOSUB 2010  'jump to viewport assignment routine
1690  ON ERROR GOTO 0  'disable error trapping override
      WINDOW SCREEN (-399, -299)-(400, 300)'establish device-independent screen coordinates
      ON KEY(1) GOSUB 1470: KEY(1) ON
      GOTO 150  'return to main program

     'module: assign scalar data
1760  D = 1400: R1 = 5.09448: R2 = 5.09448: R3 = 6.28319: MX = 0: MY = 0: MZ = -300'angular distortion, rotation factors, viewpoint distance for viewing coordinates
      X = 0: Y = 0: Z = 0: R4 = 0: R5 = 0'rotation factors for world coordinates
      F = 0'incremental factor for R5
      SR4 = SIN(R4): CR4 = COS(R4): SR5 = SIN(R5): CR5 = COS(R5)
1800  SR1 = SIN(R1): CR1 = COS(R1): SR2 = SIN(R2): CR2 = COS(R2): SR3 = SIN(R3): CR3 = COS(R3)
      RETURN

     'module:  database of points on surface of cylinder
1850  DATA  2,2,1,-1,-2.5,-3.8,-4.8,-6,-6.7,-7.5,-8,-8.5,-8.8,-9.2,-10,-10.2,-10.9,-11,-11.2,-11.5,-11.7,-11.9,-12,-12,-11.9,-11.7,-11.5,-11.2,-11,-10.9,-10.2,-10,-9.2,-8.8,-8.5,-8,-7.5,-6.7,-6,-4.8,-3.8,-2.5,-1,1,2
1860  DATA  26,26,28,29.2,31,32,33,34,35,35.8,36.5,37,37.2,37.5,37.8,38,38.2,38.3,38.5,38.6,38.6,38.6,38.5,38.3,38.2,38,37.8,37.5,37.2,37,36.5,35.8,35,34,33,32,31,29.2,27.5,25.2,23
1870  DATA  26,26,25.5,25,24.5,24.2,24,23.8,23.7,23.7,23.7,23.7,23.7,23.7,23.8,23.9,23.9,24,24.1,24.2,24.5,24.8,25.1,25.3,25.3,25.5,25.8,26,26,25.8,25.7,25.6,25.5,25.2,25.1,25,24.5,24.3,23.8,23.7,23
1880  DATA  8.2,7.9,7.5,7.1,7,6.9,6.8,6.7,6.6,6.6,6.6,6.7,6.7,6.7,6.8,6.9,7,7.1,7.3,7.5,8,8.2,8.6,8.9,9,9.1,9.4,9.6,9.9,10,10,10,10,9.9,9.8,9.5,9.4,9.1,8.9,8.4,8
1890  DATA  8.2,7,5.5,3.7,2,0,-1,-2,-2.8,-3.8,-4.5,-5.1,-5.7,-5.9,-6.3,-6.7,-7,-7.2,-7.3,-7.4,-7.5,-7.5,-7.4,-7.3,-7.1,-7,-6.7,-6.5,-6,-5.5,-4.8,-4,-3.2,-2.5,-1.5,-.5,.5,2.1,3.5,6,8
1900  DATA  12,21,21,21,21,21,21,21,20.5,20,19,18,17,16,15,15,15,15,15,12,12
1910  DATA  18.3,17.5,17.5,18.3,18.3
1920  DATA  18,19,20,20.8,21,21,21,20.8,20.3,20,19,18,17,16,15,14,13,12.2,12,12,11.8,11.8,12,12.2,12.8,13.2,14,15,16,17
1930  DATA  16.2,17,18,18.5,18.7,18.8,18.7,18,17.5,17,16,15,14.5,14,14,14,14.4,14.6,15,16.2,
1940  DATA  18,20,20.8,21,21.1,21,20.8,20.5,20,19,18,18,18,18,18,18.8,18,17.5,17.4,17.4,17.3,17,16.2,15,14,13,12.1,12,11.9,11.9,12,12.1,12.5,13.3,14.5,14.5,14.5,14.5,14.5,14,14.5,15,15,15.2,15.5,16,16.7,18
1950  DATA  20.8,12,12,20.8,20.8

     'module:  viewport parameters for 640x350, 640x200, 320x200
1990  W1 = 1: W2 = 319: W3 = 152: W4 = 470: W5 = 320: W6 = 639: W7 = 1: W8 = 174: W9 = 175: W10 = 349: RETURN
2000  W1 = 1: W2 = 319: W3 = 152: W4 = 470: W5 = 320: W6 = 639: W7 = 1: W8 = 99: W9 = 100: W10 = 199: RETURN
2010  W1 = 1: W2 = 159: W3 = 76: W4 = 235: W5 = 160: W6 = 319: W7 = 1: W8 = 99: W9 = 100: W10 = 199: RETURN